perm filename IO[GEM,BGB]1 blob
sn#032393 filedate 1973-04-01 generic text, type T, neo UTF8
00100 TITLE IO - GEOMED INPUT OUTPUT - BGB - FEBRUARY 1973.
00200
00300 EXTERN MKB,MKF,MKE,MKV,MKFRAME,BATT
00400
00500 FILNAM:0 ;FILE NAME.
00600 EXTION:0↔0 ;EXTENSION.
00700 PPPN:0 ;PROJECT-PROGRAMMER.
00800
00900 OBUF:BLOCK 3 ;OUTPUT BUFFER HEADER.
01000 IBUF:BLOCK 3 ;INPUT BUFFER HEADER.
01100 EOF:0 ;END OF FILE FLAG.
01200
01300 BLOCK 3
01400 BFRAME:BLOCK 9 ;BODY FRAME BUFFER.
01500
01600 PCNT:0 ;PARTS COUNT.
01700 FCNT:0 ;FACE COUNT.
01800 ECNT:0 ;EDGE COUNT.
01900 VCNT:0 ;VERTEX COUNT.
02000
02100 SUBR(WORDO)WORD --------------------------------------------------
02200 BEGIN WORDO; WORD OUTPUT - BGB - 18 FEBRUARY 1973.
02300 LAC ARG1
02400 SOSG OBUF+2
02500 OUT 1,0
02600 GO[IDPB 0,OBUF+1↔POP1J]
02700 FATAL(WORDO)
02800 BEND;2/18/73-------------------------------------------------------
02900
03000 WORDIN: ;----------------------------------------------------------
03100 BEGIN WORDIN; WORD INPUT TO AC0 - BGB - 18 FEBRUARY 1973.
03200 SOSG IBUF+2
03300 IN 1,0
03400 GO[ILDB 0,IBUF+1↔POP0J]
03500 STATO 1,1B22
03600 GO[FATAL(WORDIN)]
03700 SETOM EOF
03800 POP0J
03900 BEND;2/18/73-------------------------------------------------------
00100 SUBR(PLOTO)-------------------------------------------------------
00200 BEGIN PLOTO;DISPLAY BUFFER TO DISK FILE - BGB 10 DEC 1972.
00300 EXTERN DPYBUF
00400 CALL(GETFIL,[SIXBIT/PLT/])↔POP0J
00500 LAC 1,DPYBUF↔LACN(1)1↔SUBI 2
00600 CDR 2,(1)↔SETZM 1(2)
00700 MOVS↔LAPI -1(1)↔DAC DUMLST
00800 INIT 1,17↔SIXBIT/DSK/↔0↔HALT
00900 ENTER 1,FILNAM↔GO .+4
01000 OUT 1,DUMLST↔JFCL
01100 OUTSTR[ASCIZ" EOF.
01200 "]↔ RELEASE 1,
01300 POP0J
01400 DUMLST: 0↔0
01500 BEND;12/10/72------------------------------------------------------
00100 SUBR(GETFIL)EXTENSION --------------------------------------------
00200 BEGIN GETFIL;SETUP FILE SPEC FROM TTY LINE - BGB - 10 DEC 72.
00300
00400 SETZM FILNAM
00500 SETZM EXTION
00600 SETZM EXTION+1
00700 SETZM PPPN
00800
00900 OUTSTR[ASCIZ/ FILE = /]
01000 LAC 1,[POINT 6,FILNAM,-1]↔LACI 2,6
01100 INCHWL↔CAIL"a"↔SUBI 40
01200 CAIN 15↔GO[INCHWL↔POP1J]↔AOSA(P)
01300
01400 L: INCHWL↔CAIL"a"↔SUBI 40
01500 CAIN"."↔GO[LAC 1,[POINT 6,EXTION,-1]↔LACI 2,3↔GO L]
01600 CAIN"["↔GO[LAC 1,[POINT 6,PPPN,-1] ↔LACI 2,3↔GO L]
01700 CAIN","↔GO[LAC 1,[POINT 6,PPPN,17] ↔LACI 2,3↔GO L]
01800 CAIN"]"↔GO L
01900
02000 CAIN 15↔GO EOL ;END OF THE LINE.
02100 CAIN 12↔GO EOL
02200 CAIG" "↔GO L ;IGNORE GARBAGE.
02300 SOJL 2,L
02400 SUBI 40↔IDPB 1↔GO L ;ASCII TO SIXBIT.
02500
02600 EOL: INCHWL
02700 CAR PPPN
02800 TRNN 77↔LSH -6↔TRNN 77↔LSH -6 ;RIGHT ADJUST PROJECT.
02900 DIP PPPN
03000 CDR PPPN
03100 TRNN 77↔LSH -6↔TRNN 77↔LSH -6 ;RIGHT ADJUST PROGRAMMER.
03200 DAP PPPN
03300 SKIPN 1,EXTION↔LAC 1,ARG1↔DAC 1,EXTION ;DEFAULT EXTENSION.
03400 POP1J
03500 BEND;2/18/73-------------------------------------------------------
00100 SUBR(SERIAL)BODY -------------------------------------------------
00200 BEGIN SERIAL; SERIAL NUMBER THE ALT LINKS OF A BODY.
00300
00400 LAC 1,ARG1↔TEST 1,BBIT↔POP1J
00500
00600 ;COUNT FACES, EDGES, AND VERTICES.
00700 LACI 1↔PFACE 1,1↔ALT. 0,1↔CAME 1,ARG1↔AOJA .-3↔SOS↔DAC FCNT
00800 LACI 1↔PED 1,1↔ALT. 0,1↔CAME 1,ARG1↔AOJA .-3↔SOS↔DAC ECNT
00900 LACI 1↔PVT 1,1↔ALT. 0,1↔CAME 1,ARG1↔AOJA .-3↔SOS↔DAC VCNT
01000
01100 ;COUNT PARTS.
01200 SETZ↔SON 1,1↔DAC 1,2↔JUMPE 1,.+5↔AOS
01300 BRO 2,2↔CAME 1,2↔AOJA .-2
01400 DAC PCNT
01500
01600 ;OUTPUT BODY HEADER.
01700 CALL(WORDO,PCNT)
01800 CALL(WORDO,FCNT)
01900 CALL(WORDO,ECNT)
02000 CALL(WORDO,VCNT)
02100 LAC 1,ARG1
02200 CALL(WORDO,{-2(1)}) ;PNAME.
02300 CALL(WORDO,{-1(1)}) ;PNAME.
02400
02500 ;BODIES LOCATION ORIENTATION MATRIX.
02600 FRAME 1,1↔SKIPN 1↔LACI 1,L2
02700 LACI 2,=12↔SUBI 1,3
02800 L1: CALL(WORDO,{(1)})↔AOS 1↔SOJG 2,L1
02900 POP1J
03000 BLOCK 3 ;EMPTY FRAME.
03100 L2: BLOCK 9
03200 BEND;2/18/73-------------------------------------------------------
00100 SUBR(OFEV)BODY ---------------------------------------------------
00200 BEGIN OFEV; OUTPUT THE FEV OF A BODY - BGB - 18 FEBRUARY 1973.
00300 LAC 1,ARG1
00400 L1: PFACE 1,1↔CAMN 1,ARG1↔GO L2
00500 PUSH P,QQ(1)↔CALL(WORDO) ;FIRST FACE DATA WORD.
00600 PUSH P,QQ(1)↔CALL(WORDO) ;SECOND FACE DATA WORD.
00700 GO L1
00800
00900 L2: PED 1,1↔CAMN 1,ARG1↔GO L3 ;OUTPUT EDGE NODES.
01000 NFACE 2,1↔ALT 2,2↔DIP 2,0
01100 PFACE 2,1↔ALT 2,2↔DAP 2,0↔CALL(WORDO,0)
01200 NVT 2,1↔ALT 2,2↔DIP 2,0
01300 PVT 2,1↔ALT 2,2↔DAP 2,0↔CALL(WORDO,0)
01400 NCW 2,1↔ALT 2,2↔DIP 2,0
01500 PCW 2,1↔ALT 2,2↔DAP 2,0↔CALL(WORDO,0)
01600 NCCW 2,1↔ALT 2,2↔DIP 2,0
01700 PCCW 2,1↔ALT 2,2↔DAP 2,0↔CALL(WORDO,0)
01800 GO L2
01900
02000 L3: PVT 1,1↔CAMN 1,ARG1↔POP1J ;OUTPUT VERTEX NODES.
02100 CALL(WORDO,{XWC(1)})
02200 CALL(WORDO,{YWC(1)})
02300 CALL(WORDO,{ZWC(1)})
02400 GO L3
02500 BEND;2/18/73-------------------------------------------------------
02600
02700 SUBR(OBODY)BODY --------------------------------------------------
02800 BEGIN OBODY; OUTPUT BODY AND ITS PARTS - BGB - 18 FEBRUARY 1973.
02900
03000 ACCUMULATORS{N,B}
03100 CALL(SERIAL,ARG1)
03200 CALL(OFEV,ARG1)
03300 LAC B,ARG1
03400 SON N,B↔JUMPE N,L2
03500 L1: PUSH P,N↔CALL(OBODY,N)
03600 POP P,N↔LAC B,ARG1
03700 BRO N,N↔SON 0,B
03800 CAME 0,N↔GO L1
03900 L2: POP1J
04000
04100 BEND;2/18/73-------------------------------------------------------
00100 SUBR(OFORM1)BODY -------------------------------------------------
00200 BEGIN OFORM1; OUTPUT COMMANDS - BGB - 18 FEBRUARY 1973.
00300 EXTERN DPYBUF
00400 LAC 1,ARG1↔TEST 1,BBIT↔POP1J
00500 L1: CALL(GETFIL,[SIXBIT/B3D/])↔POP1J
00600 INIT 1,10↔SIXBIT/DSK/↔XWD OBUF,0↔HALT
00700 ENTER 1,FILNAM↔GO[
00800 RELEASE 1,
00900 OUTSTR[ASCIZ/ ENTER FAILED./]
01000 CRLF↔POP1J]
01100
01200 ;SETUP OUTPUT BUFFERS.
01300 PUSH P,121
01400 LAC DPYBUF↔DAC 121
01500 OUTBUF 1,
01600
01700 ;OUTPUT TRANSFER.
01800 CALL(OBODY,ARG2)
01900
02000 ;END OF FILE.
02100 RELEASE 1,
02200 OUTSTR[ASCIZ/ EOF.
02300 */]↔ POP P,121↔POP1J
02400 BEND;2/18/73-------------------------------------------------------
00100 SUBR(ICAM)--------------------------------------------------------
00200 BEGIN ICAM; INPUT CAMERA - BGB - 21 FEBRUARY 1973.
00300 EXTERN CAMERA
00400 TDZA 1,1
00500 L1: RELEASE 1,↔CALL(GETFIL,[SIXBIT/CAM/])↔GO[SETZ 1,↔POP0J]
00600 INIT 1,10↔SIXBIT/DSK/↔IBUF↔HALT
00700 LOOKUP 1,FILNAM↔GO L1
00800 PUSH P,121↔LAC DPYBUF↔DAC 121↔INBUF 1,
00900 ;INPUT TRANSFER.
01000 LAC 10,CAMERA
01100 CALL(WORDIN)↔DAC -3(10)
01200 CALL(WORDIN)↔DAC -2(10)
01300 CALL(WORDIN)↔DAC -1(10)
01400 CALL(WORDIN)↔DAC 1(10)
01500 CALL(WORDIN)↔DAC 2(10)
01600 CALL(WORDIN)↔DAC 3(10)
01700 FRAME 10,10↔SUBI 10,3↔LACI 7,=12
01800 L2: CALL(WORDIN)↔DAC (10)↔AOS 10↔SOJG 7,L2
01900
02000 ;END OF FILE.
02100 RELEASE 1,↔POP P,121
02200 OUTSTR[ASCIZ/ EOF.
02300 */]↔ POP0J
02400 BEND;2/21/73-------------------------------------------------------
00100 SUBR(OCAM)--------------------------------------------------------
00200 BEGIN OCAM; OUTPUT CAMERA - BGB - 21 FEBRUARY 1973.
00300 EXTERN DPYBUF,CAMERA
00400 L1: CALL(GETFIL,[SIXBIT/CAM/])↔POP0J
00500 INIT 1,10↔SIXBIT/DSK/↔XWD OBUF,0↔HALT
00600 ENTER 1,FILNAM↔GO[RELEASE 1,
00700 OUTSTR[ASCIZ/ ENTER FAILED./]↔CRLF↔POP0J]
00800 PUSH P,121↔LAC DPYBUF↔DAC 121↔OUTBUF 1,
00900 ;OUTPUT TRANSFER.
01000 LAC 1,CAMERA
01100 CALL(WORDO,{-3(1)})
01200 CALL(WORDO,{-2(1)})
01300 CALL(WORDO,{-1(1)})
01400 CALL(WORDO,{1(1)})
01500 CALL(WORDO,{2(1)})
01600 CALL(WORDO,{3(1)})
01700 FRAME 1,1↔SUBI 1,3↔LACI 2,=12
01800 L2: CALL(WORDO,{(1)})↔AOS 1↔SOJG 2,L2
01900 RELEASE 1,↔OUTSTR[ASCIZ/ EOF.
02000 */]↔ POP P,121↔POP0J
02100 BEND;2/18/73-------------------------------------------------------
00100 SUBR(IFEV)BODY ---------------------------------------------------
00200 BEGIN IFEV; INPUT THE FEV OF A BODY - BGB - 18 FEBRUARY 1973.
00300 ACCUMULATORS{F,E,V,A,I,J,FACE,EDGE,VERTEX}
00400
00500 ;SETUP BASE POINTER TO SERIAL TABLES.
00600 SLACI I↔LAP 121
00700 DAC FACE↔DAC EDGE↔DAC VERTEX
00800 ADD VERTEX,FCNT
00900
01000 ;MAKE AND INPUT FACES.
01100 LACI I,1
01200 L1: CALL(MKF,ARG1)↔DAC 1,@FACE
01300 CALL(WORDIN)↔DAC QQ(1)
01400 CALL(WORDIN)↔DAC QQ(1)
01500 CAME I,FCNT↔AOJA I,L1
01600
01700 ;MAKE AND INPUT EDGES.
01800 LACI I,1
01900 L2: CALL(MKE,ARG1)↔DIP 1,@EDGE
02000 CALL(WORDIN)↔DAC 1(1)
02100 CALL(WORDIN)↔DAC 3(1)
02200 CALL(WORDIN)↔DAC 4(1)
02300 CALL(WORDIN)↔DAC 5(1)
02400 CAME I,ECNT↔AOJA I,L2
02500
02600 ;MAKE AND INPUT VERTICES.
02700 LACI I,1
02800 L3: CALL(MKV,ARG1)↔DAP 1,@VERTEX
02900 CALL(WORDIN)↔DAC XWC(1)
03000 CALL(WORDIN)↔DAC YWC(1)
03100 CALL(WORDIN)↔DAC ZWC(1)
03200 CAME I,VCNT↔AOJA I,L3
03300
03400 ;CONVERT SERIAL NUMBERS TO NODE ADDRESSES.
03500 LACI J,1
03600 L4: LAC I,J↔CAR E,@EDGE
03700
03800 NFACE I,E↔CDR F,@FACE↔NFACE. F,E↔PED. E,F
03900 PFACE I,E↔CDR F,@FACE↔PFACE. F,E↔PED. E,F
04000 NVT I,E↔CDR V,@VERTEX↔NVT. V,E↔PED. E,V
04100 PVT I,E↔CDR V,@VERTEX↔PVT. V,E↔PED. E,V
04200 NCW I,E↔CAR A,@EDGE↔NCW. A,E
04300 PCW I,E↔CAR A,@EDGE↔PCW. A,E
04400 NCCW I,E↔CAR A,@EDGE↔NCCW. A,E
04500 PCCW I,E↔CAR A,@EDGE↔PCCW. A,E
04600 CAME J,ECNT↔AOJA J,L4↔POP1J
04700 BEND;2/18/73-------------------------------------------------------
00100 SUBR(IBODY)B0 ----------------------------------------------------
00200 BEGIN IBODY; INPUT BODY AND ITS PARTS - BGB - 18 FEBRUARY 1973.
00300 ACCUMULATORS{N,B,B0}
00400
00500 ;INPUT BODY HEADER.
00600
00700 CALL(WORDIN)↔DAC PCNT
00800 CALL(WORDIN)↔DAC FCNT
00900 CALL(WORDIN)↔DAC ECNT
01000 CALL(WORDIN)↔DAC VCNT
01100
01200 ;INPUT THE FEV SHELL OF THIS BODY.
01300
01400 SETQ(B1,{MKB,ARG1})
01500 LAC B0,ARG1
01600 JUMPN B0,[CALL(BATT,B1,B0)↔GO .+1]
01700 LAC B,B1
01800 CALL(WORDIN)↔DAC -2(B) ;PNAME.
01900 CALL(WORDIN)↔DAC -1(B) ;PNAME.
02000
02100 ;INPUT THE LOCATION ORIENTATION OF THIS BODY.
02200
02300 LACI 1,BFRAME-3↔LACI 2,=12↔SETZ 4,
02400 L1: CALL(WORDIN)↔DAC(1)↔IORM 4↔AOS 1↔SOJG 2,L1
02500 SKIPE 1,4↔CALL(MKFRAME)
02600 FRAME. 1,B↔JUMPE 1,.+4
02700 SLACI BFRAME-3↔LAPI XWC(1)↔BLT KZ(1)
02800 CALL(IFEV,B)
02900 LAC B,B1↔SKIPN ARG1↔DAC B,ARG1 ;RETURN VALUE TO TOP LEVEL.
03000
03100 ;INPUT THE PARTS OF THIS BODY.
03200 L2: SOSGE PCNT↔POP0J
03300 PUSH P,PCNT↔PUSH P,B
03400 CALL(IBODY)
03500 POP P,B↔POP P,PCNT↔GO L2
03600 B1:0
03700 BEND;2/18/73-------------------------------------------------------
00100 SUBR(IFORM1)------------------------------------------------------
00200 BEGIN IFORM1; INPUT FORMAT TYPE 1 - BGB - 18 FEBRUARY 1973.
00300 TDZA 1,1
00400 L1: RELEASE 1,
00500 CALL(GETFIL,[SIXBIT/B3D/])↔GO[SETZ 1,↔POP0J]
00600 INIT 1,10↔SIXBIT/DSK/↔IBUF↔HALT
00700 LOOKUP 1,FILNAM↔GO L1
00800
00900 ;SETUP INPUT BUFFERS.
01000 PUSH P,121
01100 LAC DPYBUF↔DAC 121
01200 INBUF 1,
01300
01400 ;INPUT TRANSFER.
01500 CALL(IBODY,[0])↔POP P,1
01600
01700 ;END OF FILE.
01800 RELEASE 1,
01900 POP P,121
02000 OUTSTR[ASCIZ/ EOF.
02100 */]↔ POP0J
02200 BEND;2/18/73-------------------------------------------------------
00100 SUBR(INCRE)-------------------------------------------------------
00200 BEGIN INCRE; INPUT CRE NODES.
00300
00400 ;FILE NAME ENTER FROM TTY.
00500 %←←1B18
00600 L1: CALL(GETFIL,[SIXBIT/CRE/])↔POP0J
00700 INIT 1,17↔SIXBIT/DSK/↔0↔HALT
00800 LOOKUP 1,FILNAM↔GO L1
00900
01000 ;DUMP COMMAND WORD.
01100 LAC PPPN
01200 LAPI %-1
01300 DAC INARG
01400
01500 ;CREATE UPPER SEGMENT.
01600 MOVS PPPN↔MOVMS↔ADDI %
01700 IORI 1777
01800 CORE2↔HALT
01900
02000 ;INPUT TRANSFER.
02100 IN 1,INARG
02200 RELEASE 1,
02300 OUTSTR[ASCIZ" EOF.
02400 *"]↔ CALL(MKIMGS)↔EXTERN MKIMGS
02500
02600 ;KILL UPPER SEGMENT.
02700 SETZ
02800 CORE2
02900 HALT
03000 POP0J
03100 INARG:0↔0
03200 BEND INCRE; BGB 14 MARCH 1973 -------------------------------------
03300
03400 END